home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch7 / Resize.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-05-05  |  8.1 KB  |  238 lines
  1. VERSION 5.00
  2. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  3. Begin VB.Form frmResize 
  4.    Caption         =   "Resize []"
  5.    ClientHeight    =   2895
  6.    ClientLeft      =   165
  7.    ClientTop       =   735
  8.    ClientWidth     =   3120
  9.    LinkTopic       =   "Form2"
  10.    ScaleHeight     =   2895
  11.    ScaleWidth      =   3120
  12.    StartUpPosition =   3  'Windows Default
  13.    Begin VB.PictureBox picResult 
  14.       Height          =   2295
  15.       Left            =   840
  16.       ScaleHeight     =   149
  17.       ScaleMode       =   3  'Pixel
  18.       ScaleWidth      =   157
  19.       TabIndex        =   4
  20.       Top             =   1440
  21.       Visible         =   0   'False
  22.       Width           =   2415
  23.    End
  24.    Begin VB.CommandButton cmdResize 
  25.       Caption         =   "Resize"
  26.       Default         =   -1  'True
  27.       Height          =   375
  28.       Left            =   1200
  29.       TabIndex        =   3
  30.       Top             =   0
  31.       Width           =   855
  32.    End
  33.    Begin VB.TextBox txtScale 
  34.       Height          =   285
  35.       Left            =   600
  36.       TabIndex        =   2
  37.       Text            =   "1.0"
  38.       Top             =   60
  39.       Width           =   495
  40.    End
  41.    Begin MSComDlg.CommonDialog dlgOpenFile 
  42.       Left            =   0
  43.       Top             =   360
  44.       _ExtentX        =   847
  45.       _ExtentY        =   847
  46.       _Version        =   393216
  47.    End
  48.    Begin VB.PictureBox picOriginal 
  49.       AutoSize        =   -1  'True
  50.       Height          =   2295
  51.       Left            =   120
  52.       ScaleHeight     =   149
  53.       ScaleMode       =   3  'Pixel
  54.       ScaleWidth      =   157
  55.       TabIndex        =   0
  56.       Top             =   480
  57.       Width           =   2415
  58.    End
  59.    Begin VB.Label Label1 
  60.       Caption         =   "Scale"
  61.       Height          =   255
  62.       Left            =   120
  63.       TabIndex        =   1
  64.       Top             =   60
  65.       Width           =   495
  66.    End
  67.    Begin VB.Menu mnuFile 
  68.       Caption         =   "&File"
  69.       Begin VB.Menu mnuFileOpen 
  70.          Caption         =   "&Open..."
  71.          Shortcut        =   ^O
  72.       End
  73.       Begin VB.Menu mnuFileSaveAs 
  74.          Caption         =   "Save &As..."
  75.          Shortcut        =   ^A
  76.       End
  77.    End
  78. Attribute VB_Name = "frmResize"
  79. Attribute VB_GlobalNameSpace = False
  80. Attribute VB_Creatable = False
  81. Attribute VB_PredeclaredId = True
  82. Attribute VB_Exposed = False
  83. Option Explicit
  84. ' Arrange the controls.
  85. Private Sub ArrangeControls(ByVal scale_factor As Single)
  86. Dim new_wid As Single
  87. Dim new_hgt As Single
  88.     ' Calculate the result's size.
  89.     new_wid = picOriginal.ScaleWidth * scale_factor
  90.     new_hgt = picOriginal.ScaleHeight * scale_factor
  91.     new_wid = ScaleX(new_wid, vbPixels, ScaleMode) + picOriginal.Width - ScaleX(picOriginal.ScaleWidth, vbPixels, ScaleMode)
  92.     new_hgt = ScaleY(new_hgt, vbPixels, ScaleMode) + picOriginal.Height - ScaleY(picOriginal.ScaleHeight, vbPixels, ScaleMode)
  93.     ' Position the result PictureBox.
  94.     picResult.Move _
  95.         picOriginal.Left + picOriginal.Width + 120, _
  96.         picOriginal.Top, new_wid, new_hgt
  97.     picResult.Line (0, 0)-(picResult.ScaleWidth, picResult.ScaleHeight), _
  98.         picResult.BackColor, BF
  99.     picResult.Picture = picResult.Image
  100.     picResult.Visible = True
  101.     ' This makes the image resize itself to
  102.     ' fit the picture.
  103.     picResult.Picture = picResult.Image
  104.     ' Make the form big enough.
  105.     new_wid = picResult.Left + picResult.Width
  106.     If new_wid < cmdResize.Left + cmdResize.Width _
  107.         Then new_wid = cmdResize.Left + cmdResize.Width
  108.     new_hgt = picResult.Top + picResult.Height
  109.     If new_hgt < picOriginal.Top + picOriginal.Height _
  110.         Then new_hgt = picOriginal.Top + picOriginal.Height
  111.     Move Left, Top, new_wid + 237, new_hgt + 816
  112.     DoEvents
  113. End Sub
  114. ' Transform the picture.
  115. Private Sub cmdResize_Click()
  116. Dim scale_factor As Single
  117.     ' Do nothing if no picture is loaded.
  118.     If picOriginal.Picture = 0 Then Exit Sub
  119.     ' Get the scale.
  120.     On Error GoTo ScaleError
  121.     scale_factor = CSng(txtScale.Text)
  122.     On Error GoTo 0
  123.     Screen.MousePointer = vbHourglass
  124.     picResult.Line (0, 0)-(picResult.ScaleWidth, picResult.ScaleHeight), _
  125.         picResult.BackColor, BF
  126.     DoEvents
  127.     ' Arrange picResult.
  128.     ArrangeControls scale_factor
  129.     ' Transform the image.
  130.     ResizePicture picOriginal, picResult, _
  131.         0, 0, _
  132.         picOriginal.ScaleWidth, picOriginal.ScaleHeight, _
  133.         0, 0, _
  134.         picResult.ScaleWidth, picResult.ScaleHeight
  135.     Screen.MousePointer = vbDefault
  136.     Exit Sub
  137. ScaleError:
  138.     MsgBox "Invalid scale"
  139.     txtScale.SetFocus
  140. End Sub
  141. ' Start in the current directory.
  142. Private Sub Form_Load()
  143.     picOriginal.AutoSize = True
  144.     picOriginal.ScaleMode = vbPixels
  145.     picOriginal.AutoRedraw = True
  146.     picResult.ScaleMode = vbPixels
  147.     picResult.AutoRedraw = True
  148.     dlgOpenFile.CancelError = True
  149.     dlgOpenFile.InitDir = App.Path
  150.     dlgOpenFile.Filter = _
  151.         "Bitmaps (*.bmp)|*.bmp|" & _
  152.         "GIFs (*.gif)|*.gif|" & _
  153.         "JPEGs (*.jpg)|*.jpg;*.jpeg|" & _
  154.         "Icons (*.ico)|*.ico|" & _
  155.         "Cursors (*.cur)|*.cur|" & _
  156.         "Run-Length Encoded (*.rle)|*.rle|" & _
  157.         "Metafiles (*.wmf)|*.wmf|" & _
  158.         "Enhanced Metafiles (*.emf)|*.emf|" & _
  159.         "Graphic Files|*.bmp;*.gif;*.jpg;*.jpeg;*.ico;*.cur;*.rle;*.wmf;*.emf|" & _
  160.         "All Files (*.*)|*.*"
  161.     Width = picResult.Left + picResult.Width + 120 + Width - ScaleWidth
  162.     Height = picOriginal.Top + picOriginal.Height + 120 + Height - ScaleHeight
  163. End Sub
  164. ' Load the indicated file.
  165. Private Sub mnuFileOpen_Click()
  166. Dim file_name As String
  167.     ' Let the user select a file.
  168.     On Error Resume Next
  169.     dlgOpenFile.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly
  170.     dlgOpenFile.ShowOpen
  171.     If Err.Number = cdlCancel Then
  172.         Exit Sub
  173.     ElseIf Err.Number <> 0 Then
  174.         Beep
  175.         MsgBox "Error selecting file.", , vbExclamation
  176.         Exit Sub
  177.     End If
  178.     On Error GoTo 0
  179.     Screen.MousePointer = vbHourglass
  180.     DoEvents
  181.     file_name = Trim$(dlgOpenFile.FileName)
  182.     dlgOpenFile.InitDir = Left$(file_name, Len(file_name) _
  183.         - Len(dlgOpenFile.FileTitle) - 1)
  184.     Caption = "Resize [" & dlgOpenFile.FileTitle & "]"
  185.     ' Open the original file.
  186.     On Error GoTo LoadError
  187.     picOriginal.Picture = LoadPicture(file_name)
  188.     On Error GoTo 0
  189.     ' Hide picResult.
  190.     picResult.Visible = False
  191.     If cmdResize.Left + cmdResize.Width > picOriginal.Left + picOriginal.Width Then
  192.         Width = cmdResize.Left + cmdResize.Width + 120 + Width - ScaleWidth
  193.     Else
  194.         Width = picOriginal.Left + picOriginal.Width + 120 + Width - ScaleWidth
  195.     End If
  196.     Height = picOriginal.Top + picOriginal.Height + 120 + Height - ScaleHeight
  197.     Screen.MousePointer = vbDefault
  198.     Exit Sub
  199. LoadError:
  200.     Screen.MousePointer = vbDefault
  201.     MsgBox "Error " & Format$(Err.Number) & _
  202.         " opening file '" & file_name & "'" & vbCrLf & _
  203.         Err.Description
  204. End Sub
  205. ' Save the transformed image.
  206. Private Sub mnuFileSaveAs_Click()
  207. Dim file_name As String
  208.     ' Let the user select a file.
  209.     On Error Resume Next
  210.     dlgOpenFile.Flags = cdlOFNOverwritePrompt + cdlOFNHideReadOnly
  211.     dlgOpenFile.ShowSave
  212.     If Err.Number = cdlCancel Then
  213.         Exit Sub
  214.     ElseIf Err.Number <> 0 Then
  215.         Beep
  216.         MsgBox "Error selecting file.", , vbExclamation
  217.         Exit Sub
  218.     End If
  219.     On Error GoTo 0
  220.     Screen.MousePointer = vbHourglass
  221.     DoEvents
  222.     file_name = Trim$(dlgOpenFile.FileName)
  223.     dlgOpenFile.InitDir = Left$(file_name, Len(file_name) _
  224.         - Len(dlgOpenFile.FileTitle) - 1)
  225.     Caption = "Resize [" & dlgOpenFile.FileTitle & "]"
  226.     ' Save the transformed image into the file.
  227.     On Error GoTo SaveError
  228.     SavePicture picResult.Picture, file_name
  229.     On Error GoTo 0
  230.     Screen.MousePointer = vbDefault
  231.     Exit Sub
  232. SaveError:
  233.     Screen.MousePointer = vbDefault
  234.     MsgBox "Error " & Format$(Err.Number) & _
  235.         " saving file '" & file_name & "'" & vbCrLf & _
  236.         Err.Description
  237. End Sub
  238.